home *** CD-ROM | disk | FTP | other *** search
- ⓪ ⓪ IMPLEMENTATION MODULE MathLib0; (*$ l-, r-, x+ *)⓪ (*$M- muß wg. TABLEs bleiben! *)⓪ ⓪ (*----------------------------------------------------------------------------⓪!* Mathematik-Standardbibliothek fuer Atari-Realformat mit 48 bit Mantisse⓪!*----------------------------------------------------------------------------⓪!* Text - Version : V#75378⓪!*----------------------------------------------------------------------------⓪!* jm : Juergen Mueller⓪!* TT : Thomas Tempelmann⓪!*----------------------------------------------------------------------------⓪!* Datum Version Autor Bemerkung (Arbeitsbericht)⓪!*----------------------------------------------------------------------------⓪!* 05.12.84 1.0 -- Grundversion⓪!* 16.05.85 1.1 jm Korrektur fuer sin (0.), cos (pi/2.), tan (0.)⓪!* 16.10.85 1.2 TT bei Runtimefehlern wird nun Adr. der aufrufenden⓪!* Procedure an TRAP-Routine uebergeben; nur nicht,⓪!* wenn Fehler in Proc. von Runtime auftritt.⓪!* 15.04.86 2.0 jm erweiterte Definition implementiert;⓪!* sqrt-Funktion nach ?? uebernommen.⓪!* 27.07.86 2.1 jm atanh in artanh umbenannt;⓪!* bessere Implementation von sinh, cosh.⓪!* 22.11.86 3.0 jm neues Realformat (mit Signed Exponent)⓪!* Tabellen noch nicht umgestellt!⓪!* 16.03.87 3.1 jm sqrt (0.0) korrigiert;⓪!* Umstellung des Realformats weiter⓪!* 14.06.87 3.2 jm Realformat fertig umgestellt, noch keine Tests.⓪!* cpxn-Routine korrigiert⓪!* 16.06.87 3.3 jm AdreßReg-Belegung jetzt Atari-Konvention⓪!* 19.06.87 3.4 jm Korrekturen in fraction, sin, PwrOfTwo⓪!* 08.07.87 3.4 TT Fehlermeldungen korrigiert; Register gerettet⓪!* 29.08.87 3.4 TT fraction: kein Absturz, wenn Expon.=0⓪!* 10.09.87 3.4 TT pi, e als Funktionen⓪!* 26.10.87 3.5 jm CallExc übergibt gültige String-Adr;⓪!* Continue nach Fehlern jetzt überall möglich⓪!* 27.10.87 3.5 jm real und entier zur Wandlung REAL <> LONGINT.⓪!* CallExc meldet Fehler 'callercaused';⓪!* CallExc-Aufrufer mit Dummy A5-Link⓪!* 30.10.87 3.5 TT pi, e als Variable⓪!* 24.05.88 3.6 TT Fraction korrekt bei x.0 - Werten⓪!* 27.06.88 3.7 TT expadd/expadd2-Variablen vertauscht -> alle Ex-⓪!* ponentialfunktionen.⓪!* 13.08.88 3.8 TT $M- Option, da sonst zw. Tables ProcSym stehen,⓪!* was zu Fehlern bei log-Funktionen (u.a.?) führte.⓪!* 19.01.89 3.9 TT 68881 Support (von MR, 26.8.88).⓪!* 20.02.89 3.10 TT Alle REAL-Konstante in Modulbody verlegt.⓪!* 15.06.89 TT Include-File f. Prozessoren⓪!* 16.06.89 3.11 TT Alle REAL-Konsts, die f. beide Formate verw.⓪!* werden, werden im Body korrekt zugewiesen;⓪!* Error-Behandlung überarbeitet f. FPU⓪!* 07.05.90 3.12 TT Comp V4-Anpassung, ErrBase wird nicht mehr impor-⓪!* tiert (CallExc durch TRAP ersetzt)⓪!* 28.05.90 3.13 TT Oops - $M- fehlte wieder, wie kam denn das?!⓪!* 01.06.90 TT entier f. FPU korrigiert (kein allg. Error mehr)⓪!* 18.12.90 3.14 TT int,expM1,lnP1,sincos implementiert⓪!* 20.02.91 3.15 TT fpstat-Abfragen für Sync. mit schneller CPU⓪!* 27.03.91 3.16 TT 'entier' f. TT-FPU korrigiert (vergaß UNLK, wenn⓪!* Überlauf); ST-FPU-Routinen korrigiert.⓪!* 18.04.91 3.17 TT 'power' & 'logar' für M68881 in Assembler.⓪!* exp/pwrOfTwo/pwrOfTen melden keinen Overflow mehr⓪!* bei bestimmten negativen Argumenten, sondern immer⓪!* Null.⓪!* 27.03.92 3.18 TT ld,ln,log erzeugten bei vollst. Optimierung falsche⓪!* Ergebnisse, weil die Tables teilweise wegoptimiert⓪!* wurden -> Dummy-Access auf alle benötigten Tables⓪!* hinzugefügt.⓪!* 08.02.94 3.19 TT Kein Byte-Zugriff mehr auf fpstat+1 wg. STE.⓪!*----------------------------------------------------------------------------⓪!*)⓪ ⓪ FROM MOSGlobals IMPORT Overflow, OutOfRange;⓪ FROM SFP004 IMPORT FPUError;⓪ FROM SYSTEM IMPORT ASSEMBLER;⓪ ⓪ (*$I FPU.CNF *)⓪ ⓪ CONST IEEE = M68881 OR A68881;⓪&Soft = NOT IEEE;⓪ ⓪ (* -------- Zwischenspeicher, Tabellen --------- *)⓪ ⓪ VAR pi2: LONGREAL;⓪(piDiv180: LONGREAL;⓪(invPiDiv180: LONGREAL;⓪(half: LONGREAL;⓪ ⓪ (*$? A68881:⓪ CONST⓪(fpstat = $fffa40; (* Response word of MC68881 read *)⓪(fpcmd = $fffa4a; (* Command word of MC68881 write *)⓪(fpop = $fffa50; (* Operand long of MC68881 read/write *)⓪ ⓪(A2stat = 0; (* Response word of MC68881 read *)⓪(A2cmd = 10; (* Command word of MC68881 write *)⓪(A2op = 16; (* Operand long of MC68881 read/write *)⓪ *)⓪ ⓪ (*$? Soft:⓪ VAR fpu: RECORD a,b:LONGCARD END;⓪)fpt: RECORD a,b:LONGCARD END;⓪ ⓪ ⓪ TABLE.L fptwo: $00128000;⓪ ⓪ TABLE.L sqr2: $000AB504,$F333F9DE;⓪(logk: $000B8000,$00000000;⓪'fpone: $000A8000,$00000000,⓪.$FFF2FA61,$18DC43A5,⓪.$FFFA85C8,$07A095A8,⓪.$FFFAA428,$9100003A,⓪.$FFFAD30B,$A7EE2159,⓪.$000293BB,$628EF5FA,⓪.$0002F638,$4EE1CAE4,⓪.$0012B8AA,$3B295C18;⓪ ⓪ TABLE.L tank: $FFFAA2F9,$836E4E44;⓪'tank1: $FEFAD967,$E1E426B5,⓪.$FF1A9C3D,$CBC63642,⓪.$FF3AA369,$61F9A940,⓪.$FF5AA2F5,$68557947,⓪.$FF7AA2FA,$50DA798D,⓪.$FF9AA2FF,$FC90F626,⓪.$FFBAA335,$E33C201E,⓪.$FFDAA55D,$E7312DAE,⓪.$FFFAC90F,$DAA22169;⓪ ⓪ TABLE.L atnk: $FFEBB5AB,$6364E40E,⓪.$FFEAE381,$AEE4C3E4,⓪.$FFF39249,$1C8532D1,⓪.$FFF2CCCC,$CCC81F2E,⓪.$FFFBAAAA,$AAAAAA2B,⓪.$000A8000,$00000000;⓪(⓪(x1: $FFEAC9B5,$DC62D96D,⓪.$001AA0DF,$F712123C,⓪.$002AD231,$718DED74,⓪.$FFF2C90F,$DAA22169,⓪.$FFFA9B50,$41AAE31F,⓪.$00129A82,$7999FCEF,⓪.$001ADA82,$7999FCEF,⓪.$FFFAC90F,$DAA22169,⓪.$000288D5,$B8C841A7,⓪.$000ABF90,$C712D3A3,⓪.$0012CF59,$5AEEA7CA,⓪.$000296CB,$E3F9990F,⓪.$0002D218,$01572142,⓪.$000A8000,$00000000,⓪.$00128000,$00000000,⓪.$0002C90F,$DAA22169;⓪(cosk: $000AC90F,$DAA22169;⓪ ⓪ TABLE.L sink: $FFF2A2F9,$836E4E44,⓪.$FF13B131,$3233A218,⓪.$FF42F44E,$7501852C,⓪.$FF73F183,$11E19C26,⓪.$FFA2A83C,$1924E79B,⓪.$FFCB9969,$6670BE99,⓪.$FFEAA335,$E33BA883,⓪.$0003A55D,$E7312DEB,⓪.$000AC90F,$DAA22169;⓪ ⓪ TABLE.L expk: $000A85AA,$C367CC48,⓪.$000A8B95,$C1E3EA8C,⓪.$000A91C3,$D373AB12,⓪.$000A9837,$F0518DB9,⓪.$000A9EF5,$326091A1,⓪.$000AA5FE,$D6A9B151,⓪.$000AAD58,$3EEA42A1,⓪.$000AB504,$F333F9DE,⓪.$000ABD08,$A39F580C,⓪.$000AC567,$2A115507,⓪.$000ACE24,$8C151F85,⓪.$000AD744,$FCCAD69D,⓪.$000AE0CC,$DEEC2A95,⓪.$000AEAC0,$C6E7DD24,⓪.$000AF525,$7D152487;⓪.⓪'expk2: $FFAA8B70,$00000000,⓪.$FFBAABBF,$80000000,⓪.$FFD29D9C,$CC200000,⓪.$FFE2E358,$36210000,⓪.$FFF2F5FD,$F00C0800,⓪.$0002B172,$17F7CD00,⓪.$000A8000,$00000000;⓪ ⓪ VAR logx: CARDINAL;⓪&SinSgn: CARDINAL;⓪&sercnt: CARDINAL;⓪&expadd: CARDINAL; expadd2: CARDINAL; (* werden auch als Long verwendet! *)⓪ ⓪ ⓪ (* -------- interne Funktionen --------- *)⓪ ⓪ PROCEDURE @RMUL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L A0,-(A7)⓪(SUBQ.L #8,A3⓪(MOVE.L A3,A0⓪(LEA -8(A3),A1⓪(JSR @LMUL⓪(MOVE.L (A7)+,A0⓪$END⓪"END @RMUL;⓪ ⓪ PROCEDURE @RADD;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L A0,-(A7)⓪(SUBQ.L #8,A3⓪(MOVE.L A3,A0⓪(LEA -8(A3),A1⓪(JSR @LADD⓪(MOVE.L (A7)+,A0⓪$END⓪"END @RADD;⓪ ⓪ PROCEDURE rzer;⓪"BEGIN⓪$ASSEMBLER⓪&CLR.L -8(A3)⓪&CLR.L -4(A3)⓪$END⓪"END rzer;⓪ ⓪ PROCEDURE fpsub;⓪"BEGIN⓪$ASSEMBLER⓪&TST.W -16(A3)⓪&BEQ z⓪&BCHG #0,-15(A3)⓪"z JMP @RADD⓪$END⓪"END fpsub;⓪"⓪ PROCEDURE fpdiv; (* -(A3) / -(A3) -> (A3)+ *)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L A0,-(A7)⓪(SUBQ.L #8,A3⓪(MOVE.L A3,A1⓪(SUBQ.L #8,A3⓪(MOVE.L A3,A0⓪(JSR @LDIV (* "a / b" (A1),(A0) -> (A1) *)⓪(LEA 8(A3),A1⓪(MOVE.L (A1)+,(A3)+⓪(MOVE.L (A1)+,(A3)+⓪(MOVE.L (A7)+,A0⓪$END⓪"END fpdiv;⓪$⓪ PROCEDURE pullfpu;⓪"BEGIN⓪$ASSEMBLER⓪&LEA fpt,A1⓪&MOVE.L -(A3),-(A1)⓪&MOVE.L -(A3),-(A1)⓪$END⓪"END pullfpu;⓪ ⓪ PROCEDURE getfpu;⓪"BEGIN⓪$ASSEMBLER⓪&LEA fpu,A1⓪&MOVE.L -8(A3),(A1)+⓪&MOVE.L -4(A3),(A1)+⓪$END⓪"END getfpu;⓪"⓪ PROCEDURE cmpm1;⓪"(* Mantisse der Zahl auf (A3) mit (A0)+ vergleichen *)⓪"BEGIN⓪$ASSEMBLER⓪&MOVE.L -6(A3),D0⓪&CMP.L (A0)+,D0⓪&BNE NOTEQL⓪&MOVE.W -2(A3),D0⓪&CMP.W (A0),D0⓪%NOTEQL⓪$END⓪"END cmpm1;⓪&⓪ PROCEDURE cpxn; (* ? *) (* wird nur v. arctan verw. *)⓪"BEGIN⓪$ASSEMBLER⓪&ADD.L D6,D7⓪&MOVE.L D7,A0⓪&⓪&; so ist der Vergleich hoffentlich richtig:⓪&⓪&MOVE.W -8(A3),D0⓪&CMP.W (A0)+,D0⓪&BNE NOTEQL⓪&MOVE.L -6(A3),D0⓪&CMP.L (A0)+,D0⓪&BNE NOTEQL⓪&MOVE.W -2(A3),D0⓪&CMP.W (A0)+,D0⓪&⓪&; und so ist er bestimmt falsch:⓪&⓪&(*⓪&MOVE.W -8(A3),D0⓪&CMP.W (A0)+,D0⓪&BNE NOTEQL⓪&MOVE.W (A0)+,D0⓪&CMP.W -8(A3),D0⓪&BNE NOTEQL⓪&MOVE.L (A0)+,D0⓪&CMP.L -6(A3),D0⓪&BNE NOTEQL⓪&MOVE.W (A0),D0⓪&CMP.W -2(A3),D0⓪&*)⓪&⓪%NOTEQL⓪$END⓪"END cpxn;⓪"⓪ PROCEDURE series;⓪"(* Polynomentwicklung nach dem Hornerschema;⓪%(A0) zeigt auf Koeffizienten-Tabelle,⓪%fpt enthaelt Variable,⓪%sercnt enthaelt Grad des Polynoms. *)⓪"BEGIN⓪$ASSEMBLER⓪+MOVE.L (A0)+,(A3)+⓪+MOVE.L (A0)+,(A3)+⓪+JSR @RMUL⓪+BRA SER2⓪#SER1 LEA fpt,A1⓪+MOVE.L (A1)+,(A3)+⓪+MOVE.L (A1)+,(A3)+⓪+JSR @RMUL⓪#SER2 MOVE.L (A0)+,(A3)+⓪+MOVE.L (A0)+,(A3)+⓪+JSR @RADD⓪+SUBQ.B #1,sercnt⓪+BNE SER1⓪$END⓪"END series;⓪ ⓪ ⓪ PROCEDURE fpz; (* kopiert TOS nach fpt *)⓪"BEGIN⓪$ASSEMBLER⓪&LEA fpt,A1⓪&MOVE.L -8(A3),(A1)+⓪&MOVE.L -4(A3),(A1)+⓪$END⓪"END fpz;⓪+⓪ PROCEDURE fpsqu;⓪"(* kopiert TOS nach fpu, quadriert TOS, bringt Ergebnis nach fpt *)⓪"BEGIN⓪$ASSEMBLER⓪&LEA fpu,A1⓪&MOVE.L -8(A3),(A1)+⓪&MOVE.L -4(A3),(A1)+⓪&MOVE.L -8(A3),(A3)+⓪&MOVE.L -8(A3),(A3)+⓪&JSR @RMUL⓪&JMP fpz⓪$END⓪"END fpsqu;⓪#⓪ ⓪ PROCEDURE sersqu; (* berechnet TOS * Polynom in TOS^2 *)⓪"BEGIN⓪$ASSEMBLER⓪+JSR fpsqu⓪+JSR series⓪+LEA fpu,A1⓪+MOVE.L (A1)+,(A3)+⓪+MOVE.L (A1)+,(A3)+⓪+JMP @RMUL⓪$END⓪"END sersqu;⓪ ⓪"(* Ende des Conditionals f. Softreals *)⓪ *)⓪ ⓪ (*$? A68881:⓪ PROCEDURE DoDouble;⓪ (* Auf dem Stack befindet sich ein LONGREAL und muß auch wieder als Ergebnis drauf*)⓪ BEGIN⓪"ASSEMBLER⓪(MOVEA.W #$FA40,A2⓪"DoDl1 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl1⓪(SUBQ.B #2,D0⓪(BNE DoDErr⓪(MOVE.W D1,A2cmd(A2)⓪(TST.W (A2)⓪(MOVE.L -8(A3),A2op(A2)⓪(TST.W (A2)⓪(MOVE.L -(A3),A2op(A2)⓪(SUBQ.L #4,A3⓪(TST.W (A2)⓪(MOVE.W #$7400,A2cmd(A2)⓪"DoDl2 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl2⓪(CMPI.B #8,D0⓪(BNE DoDErr⓪(; Ergebnis abholen⓪(MOVE.L A2op(A2),(A3)+⓪(TST.W (A2)⓪(MOVE.L A2op(A2),(A3)+⓪(CMPI.W #$0802,(A2)⓪(BNE DoDErr2⓪(RTS⓪!DoDErr2⓪(SUBQ.L #8,A3⓪!DoDErr LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L (A3)+⓪(CLR.L (A3)+⓪"END;⓪ END DoDouble;⓪ *)⓪ ⓪ ⓪ ⓪ (* -------- exportierte Funktionen, Assembler --------- *)⓪ ⓪ PROCEDURE ld (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪+LINK A5,#0⓪+MOVE.W -8(A3),D0⓪+BEQ.L rErr ;Argument Null⓪+BTST #0,D0⓪+BNE.L rErr ;Argument negativ⓪+ASR.W #3,D0⓪+MOVE.W D0,logx ;logx enthaelt Argument-Exponent als Integer⓪+MOVE.W #2,-8(A3) ;spaeterer Exponent⓪+LEA sqr2,A0⓪+ADDQ.L #2,A0⓪+JSR cmpm1⓪+BEQ LOG2A⓪+BPL LOG2A⓪+ADDQ.W #8,-8(A3) ;spaeterer Exponent⓪+SUBQ.W #1,logx ;dec (logx)⓪#LOG2A JSR fpz ;Argument -> fpt⓪+MOVE fpone,D0 ;Dummy-Zugriff, um Optimierung zu verhindern⓪+LEA logk,A0⓪+MOVE.L (A0)+,(A3)+⓪+MOVE.L (A0)+,(A3)+⓪+JSR @RADD⓪+JSR pullfpu⓪+LEA fpt,A1⓪+MOVE.L (A1)+,(A3)+⓪+MOVE.L (A1)+,(A3)+⓪+MOVE.L (A0)+,(A3)+⓪+MOVE.L (A0)+,(A3)+⓪+JSR @RADD⓪+LEA fpu,A1⓪+MOVE.L (A1)+,(A3)+⓪+MOVE.L (A1)+,(A3)+⓪+JSR fpdiv⓪+MOVE.B #6,sercnt⓪+JSR sersqu⓪+MOVE.W logx,D1⓪+BEQ LGEXIT⓪+BMI LGNEG⓪+MOVE.W #$0082,D0 ;Exponent 16⓪+⓪+;Argument-Exp größer Null: Ergebnis-Exp berechnen⓪+; Argument-Exponent wird zur Mantisse gemacht⓪+⓪#LOG2B SUBQ.W #8,D0 ;mit entspr. Exponenten-Korrektur..⓪+ASL.W #1,D1 ; .. linksbuendig machen⓪+BPL LOG2B⓪+MOVE.W D0,(A3)+⓪+MOVE.W D1,(A3)+⓪+CLR.L (A3)+⓪+JSR @RADD⓪+BRA LGEXIT⓪#LGNEG MOVE.W #$0083,D0 ;Exponent 16, negativ⓪+NEG.W D1⓪+BRA LOG2B⓪#rErr SUBQ.L #8,A3⓪+TRAP #6⓪+DC.W OutOfRange-$4000⓪+CLR.L (A3)+⓪+CLR.L (A3)+⓪#LGEXIT UNLK A5⓪#*)⓪#(*$? A68881:⓪+MOVE.W #$5416,D1⓪+JMP DoDouble⓪#*)⓪$(*$? M68881:⓪(FLOG2.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$*)⓪$END⓪"END ld;⓪ ⓪ PROCEDURE ln (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪(JSR ld⓪(MOVE.L #$0002B172,(A3)+⓪(MOVE.L #$17F7D1CF,(A3)+⓪(JMP @RMUL⓪$*)⓪$(*$? A68881:⓪(MOVE.W #$5414,D1⓪(JMP DoDouble⓪$*)⓪$(*$? M68881:⓪(FLOGN.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$*)⓪$END⓪"END ln;⓪"⓪ PROCEDURE log (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪(JSR ld⓪(MOVE.L #$FFFA9A20,(A3)+⓪(MOVE.L #$9A84FBD0,(A3)+⓪(JMP @RMUL⓪$*)⓪$(*$? A68881:⓪(MOVE.W #$5415,D1⓪(JMP DoDouble⓪$*)⓪$(*$? M68881:⓪(FLOG10.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$*)⓪$END⓪"END log;⓪"⓪ PROCEDURE fraction (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪+MOVEM.L D4-D5,-(A7)⓪+MOVE.W -8(A3),D2⓪+BEQ.L RZERO⓪+BMI.L FracX ;Exponent < Null: nur Nachkommastellen⓪+MOVE.W D2,D1⓪+ANDI.W #$FFF8,D2⓪+BEQ.L FracX ;Exponent = Null: nur Nachkommastellen⓪+CMPI.W #$0138,D2 ;Exponent > 39 ? nur Vorkommastellen⓪+BHI.L RZERO⓪+CMPI.W #$80,D2 ;Exponent <= 16 ?⓪+BLS UND16⓪+CMPI.W #$100,D2 ;Exponent <= 32 ?⓪+BLS UND32⓪+SUBI.W #$100,D2⓪+CLR.W D5⓪+MOVE.W -2(A3),D4⓪+LSL.W D2,D4⓪+SWAP D4⓪+CLR.W D4⓪+BRA FRO⓪#UND32 SUBI.W #$80,D2⓪+CLR.W D5⓪+MOVE.L -4(A3),D4⓪+LSL.L D2,D4⓪+BRA FRO⓪#UND16 MOVE.L -6(A3),D4⓪+MOVE.W -2(A3),D5⓪#UND16A LSL.W #1,D5⓪+ROXL.L #1,D4⓪+SUBQ.W #8,D2⓪+BNE UND16A⓪#FRO SUBQ.L #8,A3⓪+AND.W #3,D1 ;Vorzeichen und #0-Bit⓪+MOVE.W D1,(A3)⓪+TST.L D4⓪+BMI.L SUBEX ;Mantisse ist schon linksbuendig⓪+⓪+; Mantisse wieder linksbuendig machen⓪+⓪+CLR.W D1⓪+SUBQ.W #8,(A3) ;erst mal 'ne 1 Bit-Verschiebung (reicht oft)⓪+LSL.W #1,D5⓪+ROXL.L #1,D4⓪+BMI.L SUBEX⓪+BNE NORM1⓪+⓪+MOVEQ #32,D1 ;muß mindestens 32 Bit verchieben⓪+MOVE.W D5,D4⓪+BEQ.L PZERO⓪+BMI SHW1⓪#SHW ADDQ.W #1,D1⓪+LSL.W #1,D4⓪+BPL SHW⓪#SHW1 SWAP D4⓪+CLR.L D5⓪+BRA SLT16X⓪"⓪#NORM1 CMPI.L #$10000,D4⓪+BCC SLT16A⓪+MOVEQ #16,D1 ;muß mindestens 16 Bit verchieben⓪+SWAP D4⓪+MOVE.W D5,D4⓪+MOVE.L D4,D0⓪+BMI SHL1⓪#SHL ADDQ.W #1,D1⓪+LSL.L #1,D4⓪+BPL SHL⓪#SHL1 CLR.W D5⓪+BRA SLT16X⓪"⓪#SLT16A ADDQ.W #1,D1 ;muß < 16 bit verschieben⓪+LSL.W #1,D5⓪+ROXL.L #1,D4⓪+BPL SLT16A⓪#SLT16X LSL.W #3,D1⓪+SUB.W D1,(A3)⓪"⓪#SUBEX ADDQ.L #2,A3⓪+MOVE.L D4,(A3)+⓪+MOVE.W D5,(A3)+⓪#FracX MOVEM.L (A7)+,D4-D5⓪+RTS⓪#PZERO ADDQ.L #8,A3 (* push zero *)⓪#RZERO MOVEM.L (A7)+,D4-D5⓪+JMP rzer⓪#*)⓪#(*$? M68881:⓪+FMOVE.D -(A3),FP0 ; kein Runtime-Fehler möglich⓪+FINTRZ.D (A3),FP1⓪+FSUB.X FP1,FP0⓪+FMOVE.D FP0,(A3)+⓪#*)⓪#(*$? A68881:⓪+; FMOVE.D -(A3),FP0⓪%DoDl1 MOVE.W fpstat,D0⓪+TST.B D0⓪+BEQ DoDl1⓪+MOVE.W #$5400,fpcmd⓪+MOVE.W fpstat,D0⓪+SUBQ.B #8,D0⓪+BEQ noError⓪+LINK A5,#0⓪+JSR FPUError⓪+UNLK A5⓪+CLR.L -4(A3)⓪+CLR.L -8(A3)⓪+RTS⓪(noError⓪+MOVE.L -8(A3),fpop⓪+TST.W fpstat⓪+MOVE.L -(A3),fpop⓪+TST.W fpstat⓪+; FINTRZ.D (A3),FP1⓪+MOVE.W #$5483,fpcmd⓪#!entl2 MOVE.W fpstat,D0⓪+TST.B D0⓪+BEQ entl2⓪+MOVE.L -(A3),fpop⓪+TST.W fpstat⓪+MOVE.L 4(A3),fpop⓪+TST.W fpstat⓪+; FSUB.X FP1,FP0⓪+MOVE.W #$0428,fpcmd⓪#!entl3 MOVE.W fpstat,D0⓪+TST.B D0⓪+BEQ entl3⓪+; FMOVE.D FP0,(A3)+⓪+MOVE.W #$7400,fpcmd⓪#!entl4 MOVE.W fpstat,D0⓪+TST.B D0⓪+BEQ entl4⓪+MOVE.L fpop,(A3)+⓪+TST.W fpstat⓪+MOVE.L fpop,(A3)+⓪+TST.W fpstat⓪#*)⓪$END⓪"END fraction;⓪"⓪ PROCEDURE sin (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪+MOVE.B -7(A3),SinSgn ;Vorzeichen retten⓪+BCLR #0,-7(A3) ; und im Exponenten loeschen⓪+LEA sink,A0⓪+MOVE.L (A0)+,(A3)+⓪+MOVE.L (A0)+,(A3)+⓪+JSR @RMUL⓪+JSR fraction⓪+TST.W -8(A3) ;NULL?⓪+BEQ SINX ;DAS WAR'S DANN WOHL⓪+ADDI.W #16,-8(A3) ;addiere 2 zum Exponenten⓪+CMPI.W #16,-8(A3)⓪+BLT UNDTWO⓪+BCHG #0,SinSgn⓪+MOVE.L #$00138000,(A3)+ ;- 0.5 * 2 ^ 2⓪+CLR.L (A3)+⓪+JSR @RADD⓪#UNDTWO CMPI.W #$0008,-8(A3)⓪+BLT UND1⓪+MOVE.L fptwo,(A3)+⓪+CLR.L (A3)+⓪+JSR fpsub⓪#UND1 MOVE.B #7,sercnt⓪+JSR sersqu⓪+BTST #0,SinSgn⓪+BEQ SINX⓪+BSET #0,-7(A3)⓪#SINX⓪#*)⓪#(*$? M68881:⓪(FSIN.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪#*)⓪#(*$? A68881:⓪(MOVE.W #$540e,D1⓪(JMP DoDouble⓪#*)⓪$END⓪"END sin;⓪"⓪ PROCEDURE sqrt (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪)LINK A5,#0⓪)MOVEM.L D3-D7,-(A7)⓪)MOVE.L -(A3),D4⓪)MOVE.L -(A3),D0⓪)⓪'EXPONENT⓪)SWAP D0⓪)MOVE.W D0,D2 ; EXPONENT ZWISCHENSPEICHERN⓪G; FUER TEST, OB GERADE⓪)BEQ.L zero ; Zahl ist Null⓪)SUBQ.W #8,D0⓪)ASR.W #1,D0 ; Exponenten halbieren⓪)BCS.L ERROR ; Zahl ist negativ⓪)ADDQ.W #8,D0⓪)AND.W #$FFF8,D0⓪)BSET #1,D0⓪)⓪)MOVE.W D0,D7 ; neuen Exp in D7⓪)SWAP D4⓪)MOVE.W D4,D0⓪)CLR.W D4⓪)BTST #3,D2 ; EXPONENT GERADE ?⓪)BEQ INITIALISIEREN ; NEIN : KEIN SHIFT, WEITER⓪)LSR.L #1,D0 ; JA : A(1)..A(48) EINE STEL-⓪)ROXR.L #1,D4 ; LE RECHTS SCHIEBEN⓪)⓪'INITIALISIEREN⓪)MOVEQ.L #0,D2⓪)MOVEQ.L #0,D3⓪)MOVEQ.L #0,D6⓪)MOVEQ.L #1,D1 ; D[0] = 01⓪)MOVEQ #22,D5⓪)⓪'VORBER⓪)LSL.L #1,D4 ;⓪)ROXL.L #1,D0 ;⓪)ROXL.W #1,D2 ;⓪)LSL.L #1,D4 ; R[1] = A(1)A(2) - D[0]⓪)ROXL.L #1,D0 ;⓪)ROXL.W #1,D2 ;⓪)SUB.L D1,D2 ;⓪)⓪'THENTEIL⓪)LSL.L #1,D3 ; ERGEBNIS FUER NAECHSTE STELLE FREI⓪)ADDQ.W #1,D3 ; + NEUE ZIFFER = 1⓪)⓪)LSL.L #1,D4 ;⓪)ROXL.L #1,D0 ;⓪)ROXL.L #1,D2 ; I - TEN REST⓪)LSL.L #1,D4 ; BERECHNEN⓪)ROXL.L #1,D0 ;⓪)ROXL.L #1,D2 ;⓪)⓪)MOVE.L D3,D1 ; D[i]⓪)LSL.L #2,D1 ; BERECH -⓪)ADDQ.W #1,D1 ; NEN⓪)⓪)DBF D5,WEITER1⓪)BRA FERTIG⓪'WEITER1⓪)SUB.L D1,D2⓪)BPL THENTEIL⓪)⓪'ELSETEIL⓪)LSL.L #1,D3 ; ERGEBNIS FUER NAECHSTE STELLE FREI⓪G; + NEUE ZIFFER = 0⓪G⓪)LSL.L #1,D4 ;⓪)ROXL.L #1,D0 ;⓪)ROXL.L #1,D2 ; I - TEN REST⓪)LSL.L #1,D4 ; BERECHNEN⓪)ROXL.L #1,D0 ;⓪)ROXL.L #1,D2 ;⓪)⓪)MOVE.L D3,D1 ; D[i]⓪)LSL.L #2,D1 ; BERECH -⓪)ADDQ.W #3,D1 ; NEN⓪)⓪)DBF D5,WEITER2⓪)BRA FERTIG⓪'WEITER2⓪)ADD.L D1,D2⓪)BPL THENTEIL⓪)BRA ELSETEIL⓪)⓪'FERTIG⓪)BTST #1,D1⓪)BNE D2Korrigieren⓪)SUB.L D1,D2⓪)BRA Restliche24Ziffern⓪)⓪'D2Korrigieren⓪)ADD.L D1,D2⓪)⓪'Restliche24Ziffern⓪)MOVEQ #23,D5⓪)TST.L D2⓪)BMI ZiffernAddieren⓪)LSL.L #1,D3⓪)ADDQ.W #1,D3⓪)SUB.L D3,D2⓪)BRA Sprungverteiler⓪)⓪'ZiffernAddieren⓪)LSL.L #1,D3⓪)ADD.L D3,D2⓪)⓪'Sprungverteiler⓪)TST.L D2⓪)BMI RestKleinerNull⓪)⓪'DIVISION⓪)LSL.L #1,D6⓪)ADDQ.W #1,D6⓪)ASL.L #1,D2⓪)DBF D5,WEITER3⓪)BRA ErgebnisSpeichern⓪'WEITER3⓪)SUB.L D3,D2⓪)BPL DIVISION⓪)⓪'RestKleinerNull⓪)LSL.L #1,D6⓪)ADD.L D3,D2⓪)ASL.L #1,D2⓪)DBF D5,WEITER4⓪)BRA ErgebnisSpeichern⓪'WEITER4⓪)SUB.L D3,D2⓪)BPL DIVISION⓪)BRA RestKleinerNull⓪)⓪'ErgebnisSpeichern⓪)MOVEQ #0,D1⓪)MOVEQ.L #9,D2⓪)ADD.B D3,D1⓪)ROXR.L D2,D1⓪)ADD.L D6,D1⓪)LSR.L #8,D3⓪)MOVE.W D3,D0⓪)BCLR #31,D0⓪)⓪'Ergebnisuebergabe⓪)MOVE.W D7,(A3)+⓪)MOVE.W D0,(A3)+⓪)MOVE.L D1,(A3)+⓪)MOVEM.L (A7)+,D3-D7⓪)BRA sqExit⓪&⓪'zero⓪)CLR.L (A3)+⓪)CLR.L (A3)+⓪)MOVEM.L (A7)+,D3-D7⓪)BRA sqExit⓪)⓪&ERROR⓪)MOVEM.L (A7)+,D3-D7⓪)TRAP #6⓪)DC.W OutOfRange-$4000⓪)CLR.L (A3)+⓪)CLR.L (A3)+⓪&⓪&sqExit⓪)UNLK A5⓪$*)⓪$(*$? M68881:⓪(FSQRT.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪#*)⓪$(*$? A68881:⓪(MOVE.W #$5404,D1⓪(JMP DoDouble⓪$*)⓪$END⓪"END sqrt;⓪ ⓪ (* alte Version der Sqrt: NICHT UMGESTELLT AUF ATARI-REALS !⓪ ⓪ PROCEDURE sqrt (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪+MOVE.W -8(A3),D2⓪+BMI.L RERR⓪+ANDI.W #$1FFF,D2⓪+BEQ.L RZERO⓪+MOVE.L -6(A3),D7⓪+MOVE.W #$1000,-8(A3)⓪+MOVE.W D2,D3⓪+LSR.W #1,D3⓪+BCC EVNEXP⓪+SUBQ.W #1,-8(A3)⓪+LSR.L #1,D7⓪#EVNEXP MOVE.W #$0800,D3⓪+LSR.W #1,D2⓪+ADDX.W D3,D2⓪+MOVE.W D2,logx⓪+MOVE.W #$FFFF,D7⓪+MOVEQ #3,D0⓪+MOVE.W D7,D5⓪#SQL1 MOVE.L D7,D6⓪+DIVU D5,D6⓪+ADD.W D6,D5⓪+ROXR.W #1,D5⓪+DBF D0,SQL1⓪+JSR getfpu⓪+SUBQ.L #8,A3⓪+MOVE.W #$1000,(A3)+⓪+MOVE.W D5,(A3)+⓪+CLR.L (A3)+⓪+BSR SQITER⓪+BSR SQITER⓪+MOVE.W logx,-8(A3)⓪+RTS⓪#SQITER LEA fpt,A1⓪+MOVE.L -8(A3),(A1)+⓪+MOVE.L -4(A3),(A1)+⓪+LEA fpu,A1⓪+MOVE.L (A1)+,(A3)+⓪+MOVE.L (A1)+,(A3)+⓪+JSR fpdiv⓪+LEA fpt,A0⓪+MOVE.L (A0)+,(A3)+⓪+MOVE.L (A0)+,(A3)+⓪+JSR @RADD⓪+SUBQ.W #1,-8(A3)⓪+RTS⓪#RERR TRAP #6⓪+DC.W OutOfRange-$4000⓪+RTS⓪#RZERO JMP rzer⓪$END⓪"END sqrt;⓪ *)⓪ ⓪ PROCEDURE tan (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪+LEA tank,A0⓪+MOVE.L (A0)+,(A3)+⓪+MOVE.L (A0)+,(A3)+⓪+JSR @RMUL⓪+JSR fraction⓪+MOVE.W #0,A0⓪+MOVE.W -8(A3),D1⓪+BEQ.L NOTNEG ;null: NIX ZU TUN⓪+MOVE.B D1,SinSgn ;Vorzeichen retten⓪+BCLR #0,-7(A3) ; und im Exponenten loeschen⓪+TST.W D1⓪+BMI TUH ;Argument < 0.5⓪+BCHG #0,SinSgn⓪+MOVE.L fpone,(A3)+⓪+CLR.L (A3)+⓪+JSR fpsub⓪+⓪+; 0 <= Argument <= 0.5⓪+⓪#TUH CMPI.W #$FFF8,-8(A3) ;Exponent < -1 ?⓪+BLT TUQ⓪+ADDQ.W #2,A0⓪+MOVE.L #$00028000,(A3)+⓪+CLR.L (A3)+⓪+JSR fpsub⓪"⓪+; 0 <= Argument <= 0.25⓪+⓪#TUQ CMPI.W #$FFF0,-8(A3)⓪+BLT TUE⓪+ADDQ.W #1,A0⓪+SUBQ.W #8,-8(A3)⓪#TUE ADDI.W #24,-8(A3) ;Exponenten um 3 erhöhen⓪+MOVE.W A0,expadd ;Exponentenkorrektur (nicht 8fach!)⓪+LEA tank1,A0⓪+MOVE.B #8,sercnt⓪+JSR sersqu⓪+LSR expadd⓪+BCC NOTRNG⓪+JSR fpsqu⓪+MOVE.L fpone,(A3)+⓪+CLR.L (A3)+⓪+JSR fpsub⓪+LEA fpu,A0⓪+MOVE.L (A0)+,(A3)+⓪+MOVE.L (A0)+,(A3)+⓪+JSR fpdiv⓪+ADDQ.W #8,-8(A3)⓪#NOTRNG LSR expadd⓪+BCC NOTINV⓪+MOVE.L fpone,(A3)+⓪+CLR.L (A3)+⓪+JSR fpdiv⓪#NOTINV BTST #0,SinSgn⓪+BEQ NOTNEG⓪+BSET #0,-7(A3)⓪#NOTNEG⓪#*)⓪#(*$? M68881:⓪(FTAN.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪#*)⓪#(*$? A68881:⓪(MOVE.W #$540f,D1⓪(JMP DoDouble⓪#*)⓪)END⓪"END tan;⓪"⓪ PROCEDURE pwrOfTwo (x: LONGREAL): LONGREAL; (* / ausführlichst testen! *)⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪+LINK A5,#0⓪+MOVE.B -7(A3),SinSgn⓪+BCLR #0,-7(A3)⓪+CLR.L expadd⓪+MOVE.W -8(A3),D0⓪+BEQ.L XRONE⓪+ASR.W #3,D0⓪+CMPI.W #$FFFD,D0 ;Exp < -3 ?⓪+BLT EXP2A⓪+MOVE.W #12,D1⓪+SUB.W D0,D1 ;EXP >= 12 ?⓪+BLE.L EXOVFL⓪+MOVE.L -6(A3),D2⓪+ADD.W #16,D1 ;D1 >= 16⓪+LSR.L D1,D2⓪+MOVE.L D2,expadd ;Highword muß Null sein⓪+ADDI.W #32,-8(A3) ;inc (Exponent, 4)⓪+JSR fraction⓪+SUBI.W #32,-8(A3) ;dec (Exponent, 4)⓪#EXP2A LEA expk2,A0⓪+MOVE.B #6,sercnt⓪+JSR fpz⓪+JSR series⓪+MOVE.L expadd,D0⓪+LSR.L #1,D0⓪+AND.W #$FFF8,D0⓪+ADD.W D0,-8(A3)⓪+MOVE.W expadd2,D0⓪+ANDI.W #$000F,D0⓪+BEQ NOexpk⓪+SUBQ.W #1,D0⓪+LSL.W #3,D0⓪+LEA expk,A0⓪+ADDA.W D0,A0⓪+MOVE.L (A0)+,(A3)+⓪+MOVE.L (A0)+,(A3)+⓪+JSR @RMUL⓪#NOexpk BTST #0,SinSgn⓪+BEQ EXP2X⓪+MOVE.L fpone,(A3)+⓪+CLR.L (A3)+⓪+JSR fpdiv⓪+BRA EXP2X⓪#⓪#XRONE SUBQ.L #8,A3⓪+MOVE.L fpone,(A3)+⓪+CLR.L (A3)+⓪+BRA EXP2X⓪#⓪#EXOVFL BTST #0,SinSgn⓪+BNE RZERO⓪+SUBQ.L #8,A3⓪+TRAP #6⓪+DC.W Overflow-$4000⓪+CLR.L (A3)+⓪+CLR.L (A3)+⓪+BRA EXP2X⓪#⓪#RZERO UNLK A5⓪+JMP rzer⓪#⓪#EXP2X UNLK A5⓪#*)⓪#(*$? M68881:⓪(FTWOTOX.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪#*)⓪#(*$? A68881:⓪(MOVE.W #$5411,D1⓪(JMP DoDouble⓪#*)⓪#END⓪"END pwrOfTwo;⓪ ⓪ PROCEDURE pwrOfTen (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪$MOVE.L #$0012D49A,(A3)+⓪$MOVE.L #$784BCD1C,(A3)+⓪$JSR @RMUL⓪$JMP pwrOfTwo⓪$*)⓪$(*$? M68881:⓪(FTENTOX.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪#*)⓪$(*$? A68881:⓪(MOVE.W #$5412,D1⓪(JMP DoDouble⓪$*)⓪$END⓪"END pwrOfTen;⓪"⓪ PROCEDURE exp (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪$MOVE.L #$000AB8AA,(A3)+⓪$MOVE.L #$3B295C18,(A3)+⓪$JSR @RMUL⓪$JMP pwrOfTwo⓪$*)⓪$(*$? M68881:⓪(FETOX.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪#*)⓪$(*$? A68881:⓪(MOVE.W #$5410,D1⓪(JMP DoDouble⓪$*)⓪$END⓪"END exp;⓪+⓪ PROCEDURE arctan (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪$(*$? Soft:⓪,MOVEM.L D6-D7,-(A7)⓪,CLR.L expadd⓪,MOVE.W -8(A3),D0⓪,BEQ.L RZERO⓪,MOVE.W D0,SinSgn ;! kompletter Exponent im SinSgn!⓪,BCLR #0,-7(A3)⓪,CMPI.W #$8,D0⓪,BLT UNDONE⓪,MOVE.L fpone,(A3)+ ;Argument > 1: Kehrwert nehmen⓪,CLR.L (A3)+⓪,JSR fpdiv⓪#UNDONE MOVEQ #32,D6⓪,LEA x1,A0⓪,MOVE.L A0,D7⓪,SUB.L D6,D7⓪,JSR cpxn⓪,BMI X0⓪,JSR cpxn⓪,BMI XN⓪,JSR cpxn⓪,BMI XN⓪,JSR cpxn⓪,BMI XN⓪,ADD.L D6,D7⓪#XN SUBQ.L #8,D7⓪,MOVE.L D7,expadd⓪,MOVE.L D7,A0⓪,SUBA.W #16,A0⓪,MOVE.L (A0)+,(A3)+⓪,MOVE.L (A0)+,(A3)+⓪,JSR @RADD⓪,MOVE.L (A0)+,(A3)+⓪,MOVE.L (A0)+,(A3)+⓪,JSR fpdiv⓪,SUBA.W #16,A0⓪,MOVE.L (A0)+,(A3)+⓪,MOVE.L (A0)+,(A3)+⓪,JSR fpsub⓪#X0 MOVE.B #5,sercnt⓪,LEA atnk,A0⓪,JSR sersqu⓪,MOVE.L expadd,D7⓪,BEQ NOPTR⓪,MOVE.L D7,A0⓪,MOVE.L (A0)+,(A3)+⓪,MOVE.L (A0)+,(A3)+⓪,JSR @RADD⓪#NOPTR MOVE.W SinSgn,D0⓪,CMPI.W #$8,D0⓪,BLT NOINV⓪,LEA cosk,A0⓪,MOVE.L (A0)+,(A3)+⓪,MOVE.L (A0)+,(A3)+⓪,JSR fpsub⓪#NOINV MOVE.W SinSgn,D0⓪,BTST #0,D0⓪,BEQ ATNX⓪,BCHG #0,-7(A3)⓪,MOVEM.L (A7)+,D6-D7⓪,RTS⓪#RZERO MOVEM.L (A7)+,D6-D7⓪,JMP rzer⓪#ATNX MOVEM.L (A7)+,D6-D7⓪#*)⓪#(*$? M68881:⓪(FATAN.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪#*)⓪#(*$? A68881:⓪(MOVE.W #$540A,D1⓪(JMP DoDouble⓪#*)⓪$END⓪"END arctan;⓪ ⓪ (*$? A68881:⓪ ⓪ PROCEDURE cos (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W #$541D,D1⓪(JMP DoDouble⓪$END;⓪"END cos;⓪ ⓪ PROCEDURE arcsin (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W #$540C,D1⓪(JMP DoDouble⓪$END;⓪"END arcsin;⓪ ⓪ PROCEDURE arccos (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W #$541C,D1⓪(JMP DoDouble⓪$END;⓪"END arccos;⓪"⓪ PROCEDURE sinh (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W #$5402,D1⓪(JMP DoDouble⓪$END;⓪"END sinh;⓪"⓪ PROCEDURE cosh (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W #$5419,D1⓪(JMP DoDouble⓪$END;⓪"END cosh;⓪ ⓪ PROCEDURE tanh (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W #$5409,D1⓪(JMP DoDouble⓪$END;⓪"END tanh;⓪ ⓪ PROCEDURE artanh (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W #$540D,D1⓪(JMP DoDouble⓪$END⓪"END artanh;⓪ ⓪ PROCEDURE real (x: LONGINT): LONGREAL; (* Umwandlung LONGINT <> LONGREAL *)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W #$4000,fpcmd⓪(MOVE.W fpstat,D0⓪(SUBQ.B #4,D0⓪(BEQ noError⓪(LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L -4(A3)⓪(CLR.L (A3)+⓪(RTS⓪%noError⓪(MOVE.L -(A3),fpop⓪(TST.W fpstat⓪(MOVE.W #$7400,fpcmd⓪ !rel2 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ rel2⓪(MOVE.L fpop,(A3)+⓪(TST.W fpstat⓪(MOVE.L fpop,(A3)+⓪(TST.W fpstat⓪$END⓪"END real;⓪ ⓪ PROCEDURE entier (x: LONGREAL): LONGINT;⓪"BEGIN⓪$ASSEMBLER⓪(; !!! entier (-3.3) liefert -3. Sollte nicht -4 rauskommen?⓪(; FMOVE.D -(A3),FP0⓪(MOVE.W #$5400,fpcmd⓪(MOVE.W fpstat,D0⓪(SUBQ.B #8,D0⓪(BEQ noError⓪(LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(SUBQ.L #8,A3⓪(CLR.L (A3)+⓪(RTS⓪%noError⓪(MOVE.L -8(A3),fpop⓪(TST.W fpstat⓪(MOVE.L -(A3),fpop⓪(TST.W fpstat⓪(; FMOVE.L FP0,(A3)+⓪(MOVE.W #$6000,fpcmd⓪ !entl2 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ entl2⓪(SUBQ.B #4,D0⓪(BNE err⓪(MOVE.L fpop,-4(A3)⓪(TST.W fpstat⓪(RTS⓪ err LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L -4(A3)⓪$END⓪"END entier;⓪ ⓪ PROCEDURE int (x: LONGREAL): LONGREAL; (* Vorkomma-Anteil von x *)⓪"BEGIN⓪$ASSEMBLER⓪(;FINTRZ.D⓪(MOVE.W #$5403,D1⓪(JMP DoDouble⓪$END⓪"END int;⓪ ⓪ PROCEDURE lnP1 (x: LONGREAL): LONGREAL; (* log_e (x+1) *)⓪"BEGIN⓪$ASSEMBLER⓪(;FLOGNP1.D⓪(MOVE.W #$5406,D1⓪(JMP DoDouble⓪$END⓪"END lnP1;⓪ ⓪ PROCEDURE expM1 (x: LONGREAL): LONGREAL; (* e ^ (x-1) *)⓪"BEGIN⓪$ASSEMBLER⓪(;FETOXM1.D⓪(MOVE.W #$5408,D1⓪(JMP DoDouble⓪$END⓪"END expM1;⓪ ⓪ PROCEDURE sincos (x: LONGREAL; VAR sin, cos: LONGREAL); (* beide zugleich *)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A1⓪(MOVE.L -(A3),A0⓪(; FSINCOS.D -(A3),FP1:FP0⓪(MOVEA.W #$FA40,A2⓪(MOVE.W #$5431,A2cmd(A2)⓪"DoDl1 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl1⓪(MOVE.L -8(A3),A2op(A2)⓪(TST.W (A2)⓪(MOVE.L -(A3),A2op(A2)⓪(SUBQ.L #4,A3⓪(TST.W (A2)⓪(MOVE.W #$7400,A2cmd(A2) ;FMOVE.D FP0,(A0)⓪"DoDl2 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl2⓪(CMPI.B #8,D0⓪(BNE DoDErr⓪(; Ergebnis abholen⓪(MOVE.L A2op(A2),(A0)+⓪(TST.W (A2)⓪(MOVE.L A2op(A2),(A0)⓪(CMPI.W #$0802,(A2)⓪(BNE DoDErr2⓪(MOVE.W #$7480,A2cmd(A2) ;FMOVE.D FP1,(A1)⓪"DoDl3 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl3⓪(CMPI.B #8,D0⓪(BNE DoDErr⓪(; Ergebnis abholen⓪(MOVE.L A2op(A2),(A1)+⓪(TST.W (A2)⓪(MOVE.L A2op(A2),(A1)⓪(CMPI.W #$0802,(A2)⓪(BNE DoDErr2⓪(RTS⓪!DoDErr2⓪(SUBQ.L #8,A3⓪!DoDErr LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L (A3)+⓪(CLR.L (A3)+⓪$END⓪"END sincos;⓪ ⓪"(* Ende des A68881-Conditionals *)⓪ *)⓪ ⓪ (*$? M68881:⓪ PROCEDURE cos (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(FCOS.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$END;⓪"END cos;⓪ ⓪ PROCEDURE arcsin (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(FASIN.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$END;⓪"END arcsin;⓪ ⓪ PROCEDURE arccos (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(FACOS.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$END;⓪"END arccos;⓪"⓪ PROCEDURE sinh (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(FSINH.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$END;⓪"END sinh;⓪"⓪ PROCEDURE cosh (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(FCOSH.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$END;⓪"END cosh;⓪ ⓪ PROCEDURE tanh (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(FTANH.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$END;⓪"END tanh;⓪ ⓪ PROCEDURE artanh (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(FATANH.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$END⓪"END artanh;⓪ ⓪ PROCEDURE real (x: LONGINT): LONGREAL; (* Umwandlung LONGINT <> LONGREAL *)⓪"BEGIN⓪$ASSEMBLER⓪(FMOVE.L -(A3),FP0 ; kein Runtime-Fehler möglich⓪(FMOVE.D FP0,(A3)+⓪$END⓪"END real;⓪ ⓪ PROCEDURE entier (x: LONGREAL): LONGINT;⓪"BEGIN⓪$ASSEMBLER⓪(; !!! entier (-3.3) liefert -3. Sollte nicht -4 rauskommen?⓪(LINK A5,#0⓪(FMOVE.D -(A3),FP0⓪(FMOVE.L FP0,(A3)+⓪((*⓪(FMOVE.L FPSR,D0⓪(AND.B #$40,D0⓪(BEQ ok⓪(; JSR checkFPStatus⓪(*)⓪ !ok UNLK A5⓪$END⓪"END entier;⓪ ⓪ PROCEDURE int (x: LONGREAL): LONGREAL; (* Vorkomma-Anteil von x *)⓪"BEGIN⓪$ASSEMBLER⓪(FINTRZ.D -(A3),FP0 ; kein Runtime-Fehler möglich⓪(FMOVE.D FP0,(A3)+⓪$END⓪"END int;⓪ ⓪ PROCEDURE lnP1 (x: LONGREAL): LONGREAL; (* log_e (x+1) *)⓪"BEGIN⓪$ASSEMBLER⓪(FLOGNP1.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$END⓪"END lnP1;⓪ ⓪ PROCEDURE expM1 (x: LONGREAL): LONGREAL; (* e ^ (x-1) *)⓪"BEGIN⓪$ASSEMBLER⓪(FETOXM1.D -(A3),FP0⓪(FMOVE.D FP0,(A3)+⓪$END⓪"END expM1;⓪ ⓪ PROCEDURE sincos (x: LONGREAL; VAR sin, cos: LONGREAL); (* beide zugleich *)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A1⓪(MOVE.L -(A3),A0⓪(FSINCOS.D -(A3),FP1:FP0⓪(FMOVE.D FP0,(A0)⓪(FMOVE.D FP1,(A1)⓪$END⓪"END sincos;⓪ ⓪ PROCEDURE logar(b, x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(LINK A5,#0⓪(FLOGN.D -(A3),FP0⓪(FLOGN.D -(A3),FP1⓪(FDIV.X FP1,FP0⓪(FMOVE.D FP0,(A3)+⓪(UNLK A5⓪$END⓪"END logar;⓪ ⓪ PROCEDURE power(b, x: LONGREAL): LONGREAL;⓪"BEGIN⓪$ASSEMBLER⓪(LINK A5,#0⓪(FLOGN.D -16(A3),FP0⓪(FMUL.D -(A3),FP0⓪(SUBQ.L #8,A3⓪(FETOX.X FP0⓪(FMOVE.D FP0,(A3)+⓪(UNLK A5⓪$END⓪"END power;⓪ ⓪"(* Ende des M68881-Conditionals *)⓪ *)⓪ ⓪ ⓪ ⓪ (*$ L+ -------- exportierte Funktionen, Modula --------- *)⓪ ⓪ ⓪ (*$? NOT M68881:⓪ ⓪ PROCEDURE logar (b, x: LONGREAL): LONGREAL;⓪"BEGIN⓪$IF (x > 0.0) & (b > 0.0) THEN⓪&RETURN ld (x) / ld (b)⓪$ELSE⓪&ASSEMBLER⓪(; RaiseError (OutOfRange,'',callerCaused,mayContinue);⓪(TRAP #6⓪(DC.W OutOfRange-$4000⓪&END;⓪&RETURN 0.⓪$END⓪"END logar;⓪ ⓪ PROCEDURE power (b, x: LONGREAL): LONGREAL;⓪"BEGIN⓪$IF b = 0.0 THEN⓪&IF x > 0.0 THEN⓪(RETURN 0.0⓪&ELSE⓪(ASSEMBLER⓪*; RaiseError (OutOfRange,'',callerCaused,mayContinue);⓪*TRAP #6⓪*DC.W OutOfRange-$4000⓪(END;⓪(RETURN 0.⓪&END⓪$ELSIF b > 0.0 THEN⓪&RETURN exp (ln (b) * x)⓪$ELSIF fraction (x) = 0.0 THEN⓪&IF fraction (half * x) = 0.0 THEN⓪(RETURN exp (ln (-b) * x)⓪&ELSE⓪(RETURN -exp (ln (-b) * x)⓪&END⓪$ELSE⓪&ASSEMBLER⓪(; RaiseError (OutOfRange,'',callerCaused,mayContinue);⓪(TRAP #6⓪(DC.W OutOfRange-$4000⓪&END;⓪&RETURN 0.⓪$END⓪"END power;⓪ ⓪ *)⓪ ⓪ PROCEDURE rad (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$RETURN x * piDiv180;⓪"END rad;⓪ ⓪ PROCEDURE deg (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$RETURN x * invPiDiv180;⓪"END deg;⓪ ⓪ ⓪ (*$? Soft:⓪ ⓪ PROCEDURE cos (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$RETURN sin (pi2-ABS(x))⓪"END cos;⓪ ⓪ PROCEDURE int (x: LONGREAL): LONGREAL; (* Vorkomma-Anteil von x *)⓪"BEGIN⓪$RETURN x - fraction (x)⓪"END int;⓪ ⓪ PROCEDURE lnP1 (x: LONGREAL): LONGREAL; (* log_e (x+1) *)⓪"BEGIN⓪$RETURN ln (x+1.)⓪"END lnP1;⓪ ⓪ PROCEDURE expM1 (x: LONGREAL): LONGREAL; (* e ^ (x-1) *)⓪"BEGIN⓪$RETURN exp (x-1.)⓪"END expM1;⓪ ⓪ PROCEDURE sincos (x: LONGREAL; VAR s, c: LONGREAL); (* beide zugleich *)⓪"BEGIN⓪$s:= sin (x);⓪$c:= cos (x)⓪"END sincos;⓪ ⓪ ⓪ PROCEDURE arcsin (x: LONGREAL): LONGREAL;⓪"VAR x1: LONGREAL;⓪"BEGIN⓪$x1 := x*x;⓪$IF x1 = 1.0 THEN⓪&IF x < 0.0 THEN RETURN -pi2 ELSE RETURN pi2 END⓪$ELSIF ABS (x) > 1.0 THEN⓪&ASSEMBLER⓪(; RaiseError (OutOfRange,'',callerCaused,mayContinue);⓪(TRAP #6⓪(DC.W OutOfRange-$4000⓪&END;⓪&RETURN 1.⓪$ELSE⓪&RETURN arctan (x/sqrt (1.0-x1))⓪$END;⓪"END arcsin;⓪ ⓪ ⓪ PROCEDURE arccos (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$IF x = 0.0 THEN⓪&RETURN pi2⓪$ELSIF ABS (x) > 1.0 THEN⓪&ASSEMBLER⓪(; RaiseError (OutOfRange,'',callerCaused,mayContinue);⓪(TRAP #6⓪(DC.W OutOfRange-$4000⓪&END;⓪&RETURN 1.⓪$ELSIF x < 0.0 THEN⓪&RETURN pi - arctan (- sqrt (1.0-x*x)/x)⓪$ELSE⓪&RETURN arctan (sqrt (1.0-x*x)/x)⓪$END;⓪"END arccos;⓪"⓪ PROCEDURE sinh (x: LONGREAL): LONGREAL;⓪"VAR z: LONGREAL;⓪"BEGIN⓪$z := exp (x);⓪$RETURN 0.5 * (z - 1.0 / z);⓪"END sinh;⓪"⓪"⓪ PROCEDURE cosh (x: LONGREAL): LONGREAL;⓪"VAR z: LONGREAL;⓪"BEGIN⓪$z := exp (x);⓪$RETURN 0.5 * (z + 1.0 / z);⓪"END cosh;⓪ ⓪ ⓪ PROCEDURE tanh (x: LONGREAL): LONGREAL;⓪"VAR ex2: LONGREAL;⓪"BEGIN⓪$ex2 := exp (2.0 * x);⓪$RETURN (ex2 - 1.0) / (ex2 + 1.0)⓪"END tanh;⓪ ⓪ ⓪ PROCEDURE artanh (x: LONGREAL): LONGREAL;⓪"BEGIN⓪$IF ABS (x) < 1.0 THEN⓪&RETURN 0.5 * ln ((1.0 + x) / (1.0 - x))⓪$ELSE⓪&ASSEMBLER⓪(; RaiseError (OutOfRange,'',callerCaused,mayContinue);⓪(TRAP #6⓪(DC.W OutOfRange-$4000⓪&END;⓪&RETURN 1.⓪$END⓪"END artanh;⓪ ⓪ PROCEDURE real (x: LONGINT): LONGREAL; (* Umwandlung LONGINT <> LONGREAL *)⓪"BEGIN⓪$IF x >= 0L THEN⓪&RETURN FLOAT (ABS (x))⓪$ELSE⓪&RETURN - FLOAT (ABS (x))⓪$END⓪"END real;⓪ ⓪ PROCEDURE entier (x: LONGREAL): LONGINT;⓪"VAR l: LONGINT;⓪"BEGIN⓪$l := TRUNC (ABS (x));⓪$IF l > MaxLInt THEN⓪&ASSEMBLER⓪(; RaiseError (OutOfRange,'',callerCaused,mayContinue);⓪(TRAP #6⓪(DC.W OutOfRange-$4000⓪&END;⓪&RETURN MaxLInt⓪$ELSIF x >= 0.0 THEN⓪&RETURN l⓪$ELSE⓪&RETURN -l⓪$END⓪"END entier;⓪ ⓪ (* END Soft *) *)⓪ ⓪ BEGIN⓪ (*$? NOT IEEE:⓪"pi2:= 000AC90FDAA22163R;⓪"piDiv180:= 0FFDA8EFA351294E6R;⓪"invPiDiv180:= 0032E52EE0D31E16R;⓪"half:= 0002800000000000R;⓪ *)⓪ (*$? IEEE:⓪"pi2:= 3FF921FB54442D18R;⓪"piDiv180:= 3F91DF46A2529D39R;⓪"invPiDiv180:= 404CA5DC1A63C1F8R;⓪"half:= 3FE0000000000000R;⓪ *)⓪ END MathLib0.⓪ ə
- (* $FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$00007979$FFF43908$00009425$FFF43908$00008A0D$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908$FFF43908Ç$00001146T.......T.......T.......T...T...T.......T.......T.......T.......T.......T.......$000040CA$00004110$00004136$00007050$000070C5$000070EB$00007271$00007297$000072E5$0000734A$00001176$0000112D$00001146$0000734A$00001168$0000405C¶Çâ*)
-
